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DECUS ftogram Library Write-up 


DECUS NO. 8-587 


FORTRAN-D 4K OVERLAYINGS TO CHAIN PROGRAMS 


ABSTRACT 

The overlayings add five new statements to Fortran-D 4K 
supplied by Digital Equipment Corporation. 

This new version of Fortran is designed to segment large 
programs and/or to use a large amount of data. 

EXPLANATION OF NEW STATEMENTS AND THEIR USE 

The first two statements "CALL N" and "RETURN" consent 
the use of subroutines (see DECUSCOPE, Vol. 9, No. 3, pa¬ 
ge 6, by Wi11en L.). 

The "CHAIN NAME" statement is used to chain the current 
segment with the segment called "NAME". 

The filname "NAME" has the same restrictions imposed by 
DECtape Monitor System. 

These overlayings allow to use the whole DECtape No. 7 to 
store a large amount of data. The DECtape is not used in 
the usual file oriented way for I/O of data and the same 
location (of DECtape) may be used whether by "WRITE" or by 
"READ" statements. 

The "REWIND" statement is used to read again the data begin¬ 
ning from the first block. The data are stored in the 
DECtape in sequential way (not directly addressable). 

The "BLOCK OUT" statement is used whenever we wish to read 
data immediately after their writing; this statement is ne¬ 
cessary because the I/O routines transfer only full blocks 
of data, from tape to I/O buffers (and vice versa). 












# 






To write and use chaining programs, for every segment, pro¬ 
ceed in this way: 

1) Use Edit to create the source segment. 

Remember that: 

a) the first instruction of every segment must be 
"DEFINE DECTAPE"; 

b) the "DIMENSION" statement allows to create a COMMON 
area between the chaining segments. This statement 
must precede the first executable instruction in 
every segment and the common variable (integer, 
floating or subscritted) must be written on the same 
sequence; 

c) the "STOP" statement must be used only on the last 
segment; or if an error condition occurs; 

d) the "REDWIN" statement "READ 3, f, list" must prece¬ 
de the first instruction of the program if we wish to 
read data written by the program. 

2) Use FORTRAN-D Compiler to convert the source into object 

segment. The filname must be the same employed on "CHAIN" 

statement of calling segment. 


3) To execute Fortran program, call FOSL as usual; reply to 
its requests of input with the name of the first segment 
of the program, and then to the option request with "S". 


EXAMPLE: 

. FOSL 

* IN-S: (filname of the first segment) 

* 

* OP-S 

+ (+P Typed here) 


The FOSL loads the first segment and executes it. 

The next segment, if there is one, is loaded and started 
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automatically when the "CHAIN" statement is met. 

If the segment is not in the system, FOSL answers with the 
unfound name followed by a question mark. 

EXAMPLE OF USE 

If a program is divided in two segments called "PRW1" and 
"PRW2" in the following form: 

Segment PRW1 
DEFINE DECTAPE 

DIMENSION A(3) , FXQ(15) , BP(27) 


CHAIN PRW2 
END 

Segment PRM2 
DEFINE DECTAPE 

DIMENSION B(3), AQZ(15) , PR(27) 


STOP 

END 

to execute all the Fortran program it is necessary to 
load the first segment (PRW1) with the FOSL. 

Infact, during the execution of PRW1 when the "CHAIN PRW2" 
statement is met, the segment PRW2 is loaded and then exe¬ 
cuted . 

The "DIMENSION" statement creates a common area for the va¬ 
riable (A and B; FXQ; BP and PR). 

The use of the overlayings and of the new statements is de¬ 
monstrated by the program which fits a Gaussian to set of 
experimental data, put as example. 
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.EDIT 

*OUT-T: 

* 

*IN-S:GAUS 

5k 

*OPT-B 

*R 


* L 

C 

EXAMPLE PROGRAM TO USE NEW STA^lENTS. 

c 

c 

c 

c 

TO FIT A GAUSSIAN TO A SET OF DATA 
READ DATA FROM THE TTY AND STORE THEM 
ON THE DECTAPE NR. 7 . 

THIS SEGMENT IS CALLED "GAUS” 

10 

DEFINE DECTAPE 

DIMENSION NCC1 ) , A ( 1 5) 

DO 10 1=1,15 

A ( I)=0 

CONTINUE 

TYPE 200 

ACCEPT 230,NC 

TYPE 220 

DO 20 1=1,NC 

TYPE 210 

ACCEPT 240,X,Y 

20 

WRITE 3,240,X,Y 

CONTINUE 

30 

BLOCK OUT 

REWIND 

DO 40 J = 1 , NC 

READ 3,240 , X , Y 

DO 30 1=4,14,5 

ESP = (I-4>/5 

CALL 100 

A(I)=A(I)+Y*LOGF(Y)* W 

CONTINUE 

DO 40 K=1,11,5 

DO 40 1=0,2 

ESP = I + ( K - 1 )/5 

CALL 100 

A(I+ K)=A(I+K)+Y*W 

40 

CONTINUE 

TYPE 210 

CHAIN GAU1 

C 

SUBROUTINE 

100 

W= 1 

S=1 

IF (X) 110,140,120 

1 10 

1 20 

S= -1 

W=ABSF(X)** ESP 

L=ESP/2. 

B = L*2 

1 30 

1 *0 

IF (H-ESP) 130,140,130 

W=W*S 4 

RETURN 









200 

FORMAT 

C/,"FIT 

TO A GAUSSIAN",/,/"NUMBE 

2 10 

FORMAT 

(/') 


220 

FORMAT 

(/,/,"X 

Y",/ , > 

2 30 

FORMAT 

( I > 


2 40 

FORMAT 

( Ej E) 



END 




CHANNELS 


* 

.FORT 

*OUT-S:GAUS 


* IN-S:GAUS 

* 

t 

.EDIT 
*OlJT-T: 


* IN - S s GA U1 


*OPT-B 

*R 

*L 

C THIS SEGMENT CALLED " GAU1 " EVALUATES 

C SOLUTIONS OF SYSTEM WITH GAUSS-JORDAN 

DEFINE DECTAPE 
DIMENSION NCC1 ),A(15) 

DO 90 1=1,3 
P=0 

DO 30 J = 0,2 

IF (A((J+l )*5) > 10,10,30 

1 0 DO 30 K = 1 , 3 

IF (A(J*5 + K)*A(J*5 + K)-P*P) 30,30,20 

20 JP=J 

KQ=K 

P =A(J* 5 + KQ ) 

30 CONTINUE 

A ( (JP + 1)* 5)=KQ 
IF CP) 50,40,50 
40 TYPE 200 

STOP 

50 DO 60 K = 1,4 

A(JP*5+K)=A(JP*5+K)/P 
60 CONTINUE 

DO 90 J = 0,2 
P=A(J*5+KQ ) 

IF (J-JP) 70,90,70 
70 DO 80 K=1,4 

A(J*5+K)=A(J*5+K)-A(JP*5+K)*P 
80 CONTINUE 

A < J* 5 + KQ)=0 
90 CONTINUE 

DO 1 00 J = 5, 15,5 
K=A(J) 

A C K)=A(J-1 ) 

100 CONTINUE 

CHAIN GAU2 

200 FORMAT (/,"NOT SOLUTIONS",/) 

END 


* 
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.FORT 

*OUT-S: GAI.il 
f 

* I N - S S GA U1 


.EDIT 
*OUT-T: 


* IN - S: GA IJ2 

* 

*OPT-B 


*R 


* L 

C THIS SEGMENT CALLED "GAIJ2" EVALUATES 

C THE PARAMETERS OF THE GAUSSIAN 

C CENTER 

C WIDTH 

C AMPLITUDE 

C AREA 

C THEN THE VALUE "FX" OF FUNCTION AT THE 

C "X" COORDINATE OF EACH DATA POINT IS CALCULATED. 


C AT LEAST IT EVALUATES THE RATIO OF CHI-SQUARE 

C WITH THE DEGREES OF FREEDOM 

DEFINE DECTAPE 
DIMENSION NC(1)*A(15> 

PK = -A C 3) 

CENT=-A(2)*.5/AC3) 

SK=-A(3)*CENT*CENT+A(1) 

AMPL= EXP F (SK) 

WIDT=SQTF(-.5/A(3)) 

AREA=AMPL*WIDT*SQTF(2.*3.14159) 

TYPE 200,CENT,WIDT,AMPL,AREA 

REWIND 

CHSQ=0 

DO 10 J =1,N C 
READ 3,210,X,Y 

FX = AMP L*EXPF(-PK*(X-CENT)*(X-CENT >) 

TYPE 220 , X , FX 

CHSQ=RCHSQ+(Y-FX)*(Y-FX)/Y 
10 CONTINUE 

DF=NC-3 
CHDF=CHSQ/DF 
TYPE 230,CHSQ,DF,CHDF 
STOP 


200 

FORMAT 

(/,"CENTER 

= "jEj/j 

M WIDTH = "j Ej/ • 


"AMP LI . 

= ”,E,/,"AR EA 

— " , E , / , 

/ ) 

210 

FORMAT 

< E, E) 



220 

FORMAT 

(/," X = ",E," 

FX= ",E) 


230 

FORMAT 

(/,/,"CHI-SQUARE 

=",E,/ 

9 ’’DEGREES OF FREEDOM = ",Ej/ 


"CHI-SQUARE/DEGREES OF 

FREEDOM = 

M >E^/) 


END 
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.FORT 

*OUT-S:GAU2 
* 

*IN-S:GAU2 
* 


T 


• F 0 S L 

* IN - S : GAIJS 


*OPT-S 

t 

FIT TO A GAUSSIAN 


NUMBER OF CHANNELS=17 


X 

Y 


M 

6 


1 

1 1 


2 

1 7 


3 

25 


4 

34 


5 

43 


6 

52 


7 

58 


8 

61 


9 

58 


1 V) 

52 


1 1 

43 


12 

.34 


1 3 

25 


1 4 

1 7 


1 5 

1 1 


1 6 

6 


t 



t 



CENTER 

— 

0.804772E+1 

WIDTH 

= 

0.371148E+1 

AMPLI. 

= 

0.604105E + 2 

AREA 

= 

0.562017E+3 




X = 

0.000000E+0 

FX = 

0•57 5653E+1 

X = 

0.100000E+1 

FX = 

0*99 5682E+1 

X = 

0.200000E+1 

FX = 

0.160159E+2 

X = 

0.300000 E +1 

FX = 

0.239585E+2 

X = 

0•400000 E +1 

FX = 

0.333301E+2 

x= 

0•500000 E + 1 

FX = 

0*431210 E + 2 

x= 

0.600000 E +1 

FX = 

0 * 518815E + 2 

x= 

0.700000 E +1 

FX = 

0 * 580 508E + 2 

X = 

0•800000 E +1 

FX = 

0 * 60 4055E + 2 

X = 

0.900000E+1 

FX = 

0 * 58 4 544E + 2 

X = 

0*100000E+2 

FX = 

0 *5260 54E + 2 

/Y- 

0. f tf}000£*£ 

FX- 

0. 440S67 E+2 

X = 

0.120000E+2 

FX = 

0.342668E+2 

X = 

0•130000E+2 

FX = 

0.248030E+2 

x = 

0.140000E+2 

FX = 

0 * 166958E + 2 

X = 

0.1 50000 E + 2 

FX = 

0 * 104516E + 2 

X = 

0.1 60000 E + 2 

FX = 

0 * 608461 E+ 1 

CHI-SQUARE = 0.628437E+1 

DEGREES OP FREEDOM* 0.140000E+2 

CHI - 

SQUARE/DEGREES OF 

FREEDOM 

i = 0.448884E 


I 


8 





/COMPILER MODIFICATIONS TO DEFINE "RETURN"I 
/"CALX "} "CHAIN"; "REWIND" AND "BLOCK OUT" 
/STAWENTS 
✓ 

/SYSTEM DEFINITONS: 

PUNCH=4460 
0VER31=6307 
END=101 
BEGN=100 
NEWL=46 
SVSRN=127 
GOO= 5200 
TP IN = 5600 
*5365 


5365 

7 440 


SZA /IS IT AN "0"? 

5366 

5374 


JMP .+6 /NO 
*5374 

5374 

1 377 


TAD C7 

53 75 

5776 


JMP I .+1 /SECOND CHARACTER IS "A" OR "H”? 

5376 

3 7 70 


3 7 70 

5377 

0007 

Cl, 

7 

*3 770 

3 7 70 

7640 


SZA CLA 

3771 

5373 


JMP .+2 /SECOND CHARACTER IS "A" 

3 7 72 

5777 


JMP 1 .+5 /SECOND CHARACTER IS "H" 

3773 

1 376 


TAD .+3 /TAKE CALL=61 

3774 

5775 


JMP I .+1 /JUMP TO THE NEXT HOLE FOR PATCH 

37 75 

51 73 


5173 /ON 5173 

3 7 76 

0061 


61 /CALL=61 

3777 

4370 


4370 /PATCH ON 4370 OVERLAY BLOCK FOR CHA 

*4370 

4370 

1 375 


TAD C6111 

4371 

3774 


DCA I RRS 

4372 

4 52 7 


JMS I Z SVSRN /CHAIN STATMENT ROUTINE 

4373 

0003 


3 

43 7 4 

6512 

RRS* 

6512 

4375 

61 1 1 

C6111> 

6111 /STARTING ADDRESS OF ROUTINE 

*6311 /OVERLAY BLOCK NUMBER 2 

631 1 

1 370 

RCHAINj 

TAD R63 /TAKE CHAIN=63 

6312 

4460 


PUNCH /PUNCH NEXT INST. CHAIN 

631 3 

1 367 


TAD C4 /PREPARE FOR SKIPPING 4 LETTERS 

631 4 

4707 


JMS I 0VER31 /STEP 4-CHARACTER THRU STATMEN 

6315 

1 100 


TAD Z 6EGN 

631 6 

3101 


DCA Z END 

631 7 

4341 

LI KK j 

JMS LGET /GET A CHARACTER 

6320 

7106 


RTL CLL 

6321 

7006 


RTL 

6322 

7006 


RTL 

6323 

3371 


DCA W0RD1 /SAVE 1ST. LEFT HALF 

632 4 

4341 


JMS LGET 

6325 

1 371 


TAD W0RD1 

6 32 6 

3371 


DCA WORD1 /SAVE 1ST. PACKED WORD 

6327 

4341 


JMS LGET 

6330 

7106 


RTL CLL 
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6331 

700 6 


RTL 

6332 

700 6 


RTL 

6333 

3372 


DCA W0RD2 /SAVE SECOND LEFT HALF 

6334 

4341 


JMS LGET 

6335 

1 372 


TAD W0RD2 

6336 

3372 


DCA W0RD2 /SAVE SECOND PACKED WORD 

6 33 7 

4341 


JMS LGET /LOOK FOR CR 

6340 

5353 


JMP TOMN /MORE THAN 4-CHARACTER 

6341 

0000 

LGET > 

0 

6342 

1 501 


TAD I Z END /GET A CHARACTER 

6343 

3373 


DCA LCHAR /SAVE IT 

6344 

2101 


ISZ END 

6345 

1 373 


TAD LCHAR /IS IT A CR? 

6346 

7450 


SNA 

6347 

5362 


JMP PUC /YES: END OF NAME 

6350 

1 374 

LOK, 

TAD P40 /CREATE STRIPPED 

6351 

0375 


AND C77 /ASCI I + 40 

6352 

5741 


JMP I LGET 

6353 

7200 

TOMN, 

CLA /TOO MANY CHARACTERS 

6354 

1 501 


TAD I Z END 

6355 

3373 


DCA LCHAR 

6356 

2101 


ISZ END 

6357 

1 373 


TAD LCHAR 

6360 

7640 


SZA CLA 

6361 

5353 


JMP TOMN 

6362 

1 371 

PUC, 

TAD WORD1 

6363 

4460 


PUNCH 

6364 

1 372 


TAD W0RD2 

6365 

4460 


PUNCH 

6366 

5446 


JMP I Z NEWL /NEW LINE 

6367 

0004 

C4, 

4 

6370 

0063 

R63, 

63 

6371 

0000 

WORD1> 

0 

6372 

0000 

W0RD2 1 

0 

6373 

0000 

LCHAR > 

0 

6374 

00 40 

P 40 » 

40 

6375 

0077 

Oil t 

77 

*51 73 

51 73 

4460 


PUNCH /PUNCH NEXT INST. CALL 

51 74 

7240 


CLA CMA /PREPARE FOR SKIPPING 3 LETTERS 

51 75 

5776 


JMP I .+1 /READ STATMENT NUMBER AS IN GO TO 

51 76 

520 7 


GOO+7 
*51 45 

51 45 

4561 


IBIN /OTHER OUTLET FOR IBIN 
*5165 

51 65 

4566 


RETO /OTHER OUTLET FOR READ AND RETURN 
*4560 

4560 

1 365 

RETU, 

TAD CRET /FORM RETURN=62 

4561 

1 364 

IBIN, 

TAD CIBI /FORM IBIN INSTR.=60 

4562 

4460 


PUNCH /PUNCH IT 

4563 

5446 


JMP I NEWL /NEW LINE 

4564 

0060 

CIBI, 

60 / = I B I N 

4565 

0002 

CRET , 

2 /RETURN=60+2 

4566 

2101 

RETO, 

ISZ ED 

4567 

2101 


ISZ END /SKIP OTHER 2 LETTERS 
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IF 3RD. LETTER IS "A" OR NOT 


4570 

1 501 


TAD I END 

/TEST IF 3RD. LETTER IS "A" i 

4571 

1 377 


TAD M30 1 

/-"A" 

4572 

7440 


SZA 


4573 

5776 


JMP I .+3 

/TEST IF 3RD LETTER IS "T" OR 

4 5 7 4 

5775 


JMP I .+1 

/READ 

4575 

5600 


TP IN 

/COMPILE IT ON TP IN AS USUAL 

4 5 76 

4170 


41 70 


4577 

7477 

M30 W 

-30 1 

*5635 

/-A 

563 5 

0002 

C4A, 

2 

* 4170 

/SKIP OVER REMAINING 2 CHARAC 

41 70 

1 376 


TAD M23 


4171 

7 6 50 


SNA CLA 


41 72 

57 7 5 


JMP I .+3 

/3RD CHARACTER IS "T" 

41 73 

5774 


JMP I .+1 

/ 3RD CHARACTER IS "W" 

41 74 

3171 


3171 

/ROUTINE TO COMPILE REWIND 

41 75 

4560 


4560 

/ROUTINE TO COMPILE RETURN 

41 76 

7755 

M2 3 » 

-23 

*31 71 


3171 

1 374 

REWI , 

TAD C57 

/FORM REWIND*57 

31 72 

4460 


PUNCH 

/PUNCH IT 

31 73 

5446 


JMP I NEWL /NEW LINE 

31 74 

0057 

C 57 > 

57 

*4360 


43 60 

1 366 


TAD C60 56 
* 43 66 

/NEW ORIGIN 

4366 

60 56 

C6056, 

60 56 



BEGN 0100 
ClBI 4564 
CRET 4565 
C4 6367 

C4A 5635 
C57 3174 

C 60 56 4366 

C6111 4375 

C7 5377 

C 7 7 6375 

END 0101 
GOO 5200 
IBIN 4561 
LCHAR 6373 
LGET 6341 
LIKK 6317 
LOK 6350 
M23 4176 

M301 4577 

NEWL 0046 
OVER31 6307 
PUC 6362 
PUNCH 4460 
P 40 6374 

RCHAIN 6311 
RETO 4566 
RETU 4560 
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REWI 

RRS 

R63 

SVSRN 

TOMN 

TP IN 

WORD1 

W0RD2 

31 71 

4374 

6370 

0127 

6353 

5600 

6371 

6372 

. LOAD 



* IN-D7:.FT.> S:F02 

* 

* 

ST = 

ttt 

JSAVE .FT.1200-7377i0 
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/FORTRAN D OPERATING SYSTEM LOADER 
/(FOSL) MODIFICATIONS TO SERVICE 
/"CH/UN"J "REWIND" AND "BLOCK OUT" 
/STATEMENTS 
/ 

/SYSTEM DEFINITIONS: 

TMES=560 
TTY0UT=514 
C200 = 73 
ILC=14 
10 ERR = 4000 
DNSRN=23 
SBSRN=24 
AX0 = 10 
AX 1 = 1 1 
LTST=20 
LNDX=21 
BUF'ADR = 43 
8UF0BJ = 44 
FH2A=301 
0BJBLK = 2 7 
MP NT =15 
LNK WD= 42 
GTWD= 41 
SYSI0=77 
MO NR ET= 7 6 
GETSW1=743 
GETLNK= 7 34 
I NT I = 1 51 
TEMB=16 
TEMC=17 
PUT8LK=7 54 
PUTLNK=756 
P U T = 7 4 5 
P UTEOF=101 • 

PUTSW1=777 
DUMMY = 47 6 
NULL=113 
SWCH= 636 
TPWD=637 
PSW1 =707 
TEMP Z = 71 1 

*20 5 


020 5 

5476 

JMP 

I Z MONRET./NO t RETURN TO MONITOR 



*2 56 

0256 

1273 FH 3 > 

TAD 

C70 5 /PREPARE FOR THE I/O 

0257 

3674 

DCA 

I PTW 

02 60 

1275 

TAD 

C 70 3 

0261 

3676 

DCA 

I GTW 

0 2 62 

700 1 

I AC 

/GET BLOCK NR=1 

0263 

3442 

DCA 

I LNKWD 

0 2 64 

4441 

JMS 

I GTWD /PRIME THE INPUT BUFFER 

0265 

7300 

CLA 

CLL 

0266 

7001 

I AC 

/GET DUMMY LOCATION 
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0267 

3677 


DCA I DUMW 

0270 

1 300 


TAD C2 /SET LINK FOR NEXT BLOCK 

0271 

3442 


DCA 1 LNKWD 

0272 

5301 


JMP FH2A 

0273 

0 70 5 

C70 5, 

70 5 

0274 

5353 

PTW, 

753+4400 

0275 

0 70 3 

C703, 

70 3 

0276 

5331 

GTW, 

731+4400 

0277 

5076 

DUMW, 

DUMMY+4400 

0300 

0002 

C2 , 

2 




5k 40 4 

0 40 4 

4477 


JMS I Z SYSIO /READ A BLOCK FROM SYS DEV 




*442 

0442 

5670 


JMP I P200 /BEGIN PROGRAM EXECUTION (.OS.) 




/CHAIN STATMENT ROUTINE 

0443 

1414 

CCHAIN, 

TAD I Z ILC /GET 1ST CHARACTER OF FILE NAME 

0 444 

3266 


DCA FILN1 

0 445 

1 41 4 


TAD I Z ILC /GET LAST CHARACTERS OF FILE NAME 

0 446 

3267 


DCA FILN2 

0447 

1271 


TAD FBLKK 

0 450 

3253 

FGO, 

DCA FCORE-1 

0451 

4477 


JMS I Z SYSIO/CALL THE FOSL 

0452 

0003 


3 /FUNCTION-READ 

0 453 

0000 


0 

0 454 

0000 

FCORE, 

0 

0455 

0000 

FLINK, 

0 

0456 

4000 


IOERR 

0457 

1254 


TAD FCORE 

0460 

1073 


TAD Z C200 /INCREMENT CORE LOCATION 

0461 

3254 


DCA FCORE 

0462 

1255 


TAD FLINK /GET NEXT BLOCK NUMBER 

0463 

7440 


SZA 

0464 

52 50 


JMP FGO /CONTINUE LOADING 

0465 

5554 


JMP I Z SSTR /RETURN FROM FOSL CALL 

0466 

0000 

FILN1, 

0 /STORE 1ST LETTERS OF FILE NAME 

0467 

0000 

FILN2 , 

0 /STORE LAST LETTERS OF FILE NAME 

0 4 70 

2772 

P200 , 

2772 

0471 

0000 

FBLKK , 

0 /BLOCK NUMBER OF FOSL+1 




*472 

0472 

0001 

SAVB, 

1 /1 ST BLOCK OF I/O IN D7 

0473 

6065 

C6065, 

6065 

0474 

3200 

M4600, 

-4600 

0475 

5000 

C5000 , 

5000 




*402 

0402 

4000 


IOERR /TRIED TO READ TOO MANY BLOCKS 




*41 1 

041 1 

4000 


IOERR /SYSTEM DEVICE READ ERROR 




*423 

0423 

4000 


IOERR 




*1 54 

01 54 

2000 

SSTR, 

KMOVE 

0155 

1 600 

LLKK, 

1 600 




*200 

0200 

4555 

BEGIN, 

JMS I Z LLKK 


*1056 
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1056 

1272 


TAD DN200 /YES,GET 1ST SAN BLOCK NR 

*1072 

10 72 

0200 

DN200, 

200 /BLOCK NR OF 1ST SAN BLOCK 
* 1 600 

1 600 

0000 

LKLK, 

0 

1 60 1 

302 7 


DCA OBJBLK 

1 602 

1027 


TAD OBJBLK /IS IT COMPILE &GO? 

1 60 3 

7640 


SZA CL.A 

1 60 4 

5600 


JMP I LKLK /YES 

1 60 5 

4423 


JMS I DNSRN /GET SAM NUMBER 

1 60 6 

4657 


4657 /FOSL 

1 60 7 

6354 


6354 

1610 

4336 


JMS WRITE /FOSL IS NOT FOUND IN SYS DEV 

1 61 1 

4424 


JMS I SBSRN /GET BLOCK NUMBER 

1 612 

5210 


JMP . -2 

1 613 

7001 


IAC /INCREMENT BLOCK NR 

1 61 4 

3 70 7 


DCA I FF6LK /SAVE BLOCK NUMBER*1 

1 61 5 

5600 


JMP I LKLK /RETURN 

1616 

1712 

LKO, 

TAD I BL /BLOCK NR OF FOSL 

1617 

3 70 7 


DCA I FFBLK /SAVE IT ON 471 

1 620 

1 710 


TAD I FNAM1 

1 621 

3240 


DCA NAM1 

1 622 

1711 


TAD I FNAM2 

1 623 

3241 


DCA NAM2 

1 624 

1 323 


TAD TDN /DNSRCH ROUTINE MODIFICATIONS 

1 62 5 

3722 


DCA I POTR /POINTER 

1 626 

2 322 


ISZ POTR 

1 62 7 

1 324 


TAD ADN 

1 630 

3722 


DCA I POTR 

1 631 

2322 


ISZ POTR 

1 632 

1 325 


TAD NDN 

1 633 

3722 


DCA I POTR 

1 634 

2322 


ISZ POTR 

1 635 

1 326 


TAD SCL 

1 636 

3722 


DCA I POTR 

1 637 

4423 


JMS I DNSRN /GET SAM NUMBER OF 

1 640 

0000 

NAM1 , 

0 /NEXT FILE NAME 

1 641 

0000 

NAM2 , 

0 

1 642 

4336 


JMS WRITE /FILE IS NOT FOUND IN SYS DEV 

1 643 

4424 


JMS I SBSRN /GET BLOCK NUMBER 

1 644 

5242 


JMP .-2 

1 645 

3713 


DCA I C2 601 /SAVE IT 

164 6 

1 31 4 


TAD C6000 

1 647 

3715 


DCA I C2600 

1 6 50 

72 40 


CLA CMA 

1 651 

371 6 


DCA I C2 602 

1 652 

1 327 


TAD SMC /PUT INTO ROUTINE SBSRN FOR SYS 

1 653 

3 721 


DCA I POTR1 

1 654 

1 51 3 


TAD I Z NULL /IS IT I/O? 

1 655 

7440 


SZA 

1 656 

4730 


JMS I SASW /YES: SAVE FLAG 

1 657 

1010 

FMOVE, 

TAD Z AX0 /MOVE I/O ROUTINE 

1 660 

1011 


TAD Z AX 1 

1 661 

1020 


TAD LTST 

1 662 

7440 


SZA 
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1 663 

5720 


JMP I 

MONITR 

1 664 

1 410 

KFH1 * 

TAD I 

Z AX0 

1 665 

341 1 


DCA I 

Z AX 1 

1 666 

2021 


ISZ LNDX 

1 667 

5264 


JMP KFH1 

1 670 

1 51 3 


TAD I 

Z NULL /IS IT 

1 671 

7440 


SZA 


1 672 

4731 


JMS I 

PUSW /YES: PUT 

1 673 

1043 


TAD BUFADR /SET UP F' 

1 674 

3444 


DCA I 

BUFOBJ 

1 675 

1073 


TAD Z 

C200 

1 676 

1 332 


TAD P 5 

1 677 

3733 


DCA I 

IP200 /SET NEW 

1 700 

1 334 


TAD P 5535 /JMP I Z 

1 701 

3335 


DCA P 510 7 /TTYIN+ 6 

1 702 

4777 


JMS I 

TMSI /TYPE 

1 703 

0336 


336 

/ t 

1 70 4 

021 5 


21 5 

/CR 

1 70 5 

4212 


4212 

/LF 

1 70 6 

5717 


JMP I 

KFH2A 

1 70 7 

0471 

FFBLK, 

F8LKK 

/ 47 1 

1710 

50 66 

FNAM1, 

FILN1+4400 /466+ 4400 

171 1 

50 67 

FNAM2 * 

FILN2+4400 /467+4400 

1 712 

50 71 

BL> 

FBLKK+ 4400 /471+4400 

1 71 3 

2 601 

C2 601 * 

2 60 1 


1714 

6000 

C6000 > 

6000 


171 5 

2600 

C2600 * 

2 600 


1716 

2602 

C2602* 

2602 


1717 

0 301 

KFH2A » 

FH2A 


1 720 

7600 

MONITR* 

7600 


1 721 

1054 

POTR1, 

1054 


1 722 

1051 

POTR, 

1051 


1 723 

1 700 

TDN# 

1 700 

/TAD I DNT3 

1 724 

0302 

ADN, 

302 

/AND DN6000 

1 725 

7000 

NDN, 

7000 

/NOP 

1 726 

7650 

SCL* 

7650 

/SNA CLA 

1 72 7 

7700 

SMC » 

7700 

/SNA CLA 

1 730 

3000 

SASW* 

SSW 


1 731 

30 7 5 

PUSW* 

PSW 


1 732 

0005 

P5j 

5 


1 733 

50 70 

IP200 * 

P200+4400 

1 734 

5535 

P553S* 

5535 


1 735 

5107 

P 51 0 7 * 

5107 


1 736 

0000 

WRITE* 

0 /ROUTINE TO TYPE 

1 737 

7346 


CLA CLL CMA RTL /SET 

1 740 

1 336 


TAD WRITE 

1 741 

3336 


DCA WRITE 

1 742 

4777 


JMS I 

TMSI /TYPE 

1 743 

0215 


21 5 

/CR 

1 744 

4212 


4212 

/LF 

1 745 

4355 


JMS PRINT /TYPE 1 ST ' 

1 746 

2336 


ISZ WRITE 

1 747 

4355 


JMS PRINT /TYPE LAST 

1 750 

1 374 


TAD SPACE 

1 751 

4776 


JMS I 

TYPE 


I/O? 

FLAG FOR NEXT STEP 
OR SYSTEM DEVICE INPUT 


START 
ENFI 


OF .OS. 


ERROR 
AC= - 3 


CHARACTERS 


CHARACTERS 
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1 7 52 

1 373 


TAD QMARK 

1 753 

4776 


JMS I TYPE 

1 754 

5720 


JMP I MONITR 

1 755 

0000 

PRINT, 

0 

1 756 

1 736 


TAD I WRITE 

1 757 

7106 


RTL CLL 

1 7 60 

7006 


RTL 

1 761 

7006 


RTL 

1 7 62 

700 4 


RAL 

1 763 

0 37 5 


AND P 77 

1 764 

1 374 


TAD SPACE 

1 765 

4776 


JMS I TYPE 

1 766 

1 736 


TAD I WRITE 

1 767 

0375 


AND P 77 

1 7 70 

1 374 


TAD SPACE 

1 771 

4776 


JMS I TYPE 

1 772 

5755 


JMP I PRINT 

1 773 

0277 

QMARK, 

277 

1 7 74 

0240 

SPACE, 

2 40 

1 775 

00 7 7 

P 77, 

7 7 

1 776 

0 514 

TYPE, 

TTYOUT 

1 111 

0 560 

TMSI , 

TMES 

*754 

0754 

000 1 

PUTBLK, 

1 

*756 

0756 

0002 

PUTLNK, 

2 /NEXT BLOCK NR 

*762 

0 762 

1 354 


TAD PUTBLK /GET NEXT BLOCK 

0763 

700 1 


I AC 

0764 

3354 


DCA PUTBLK 

0765 

1 356 


TAD PUTLNK /GET NEXT LINK 

0766 

7450 


SNA /IS THIS LINK ZERO? 

0767 

5501 


JMP I PUTEOF /YES, FINISH PROGRAM EXEC. 

0 770 

7001 


I AC 

0 7 7 1 

3356 


DCA PUTLNK 

0 7 72 

1 355 


TAD PUTBLK+1 /SET BUFFER POINT 

0773 

3375 


DCA BOUT 

0774 

5745 


JMP I PUT 

0775 

5600 

BOUT, 

5600 

0776 

0000 

BINP, 

0 

*746 

0746 

3775 


DCA I BOUT /SAVE WORD IN BUFFER 

0747 

2375 


ISZ BOUT 
*713 

0 713 

1 776 


TAD I BINP /GET WORD FROM BUFFER 

0714 

2376 


ISZ BINP 
*723 

0723 

3376 


DCA BINP 
*2000 

/MOVE SSW, PSW AND REW ROUTINES 

2000 

1 226 

KMOVE, 

TAD SAX 1 /PREPARE AUTOINDEX 

200 1 

30 1 6 


DCA Z TEMB 

2002 

1 22 7 


TAD SAX2 

200 3 

30 1 7 


DCA Z TEMC 

200 4 

1 41 6 

FX0 , 

TAD I TEMB /MOVE SSW ROUTINE (2200-3000) 
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I 


2005 

341 7 


DCA I TEMC 

2006 

2230 


ISZ SAZ 

2007 

520 4 


JMP FX0 

2010 

7300 


CLA CLL /PREPARE AUTOINDEX 

201 1 

1231 


TAD REX 1 

2012 

301 6 


DCA Z TEMB 

2013 

1232 


TAD REX2 

201 4 

301 7 


DCA Z TEMC 

201 5 

1 41 6 

FX1 , 

TAD I TEMB /MOVE REW ROUTINE <2400- 

2016 

341 7 


DCA I TEMC 

201 7 

2233 


ISZ REZ 

2020 

5215 


JMP FX1 

2021 

7300 


CLA CLL 

2022 

301 6 


DCA Z TEMB 

2023 

30 1 7 


DCA Z TEMC 

2024 

5625 


JMP I SSTT 

2025 

1 61 6 

SSTT , 

LKO 

2026 

2177 

SAX 1 , 

21 77 

2027 

2777 

SAX2 , 

2777 

20 30 

7600 

SAZ, 

-200 

20 31 

2377 

REX1 , 

2377 

20 32 

5777 

REX2, 

5777 

2033 

7755 

REZ, 

-23 

*6000 

/ROUTINE FOR REWIND STATMENT 

6000 

4477 

REW, 

JMS I SYSIO /READ IN THE BUFFER 

6001 

0 70 3 


70 3 

6002 

0001 

RBLK > 

1 

600 3 

5400 

RCOR, 

5400/ CORE ADDRESS 

600 4 

0000 

RLNK , 

0 

600 5 

4000 


IOERR 

600 6 

1076 


TAD MONRET 

600 7 

361 5 


DCA I RGTSW 

60 10 

120 3 


TAD RCOR 

601 1 

361 7 


DCA I BINW 

6012 

1 20 4 


TAD RLNK /SAVE BLOCK NR OF THE NEX' 

601 3 

361 6 


DCA I TLNK 

6014 

5551 


JMP I Z INTI /GET NEXT INSTRUCTION 

60 15 

5343 

RGTSW, 

GETSW1 +4400 

601 6 

5334 

TLNK , 

GETLNK+4400 

6017 

5376 

BINW, 

BINP + 4400 

/ROUTINE FOR "BLOCK 0UT"STATMENT 

6020 

1 650 

BLOT, 

TAD I SBOT /SAVE BOUT 

6021 

3251 


DCA SRI 

6022 

1 653 


TAD I SPBK /SAVE PUTBLK 

6023 

3255 


DCA SR3 

6024 

4240 


JMS FI LB 

6025 

1251 


TAD SRI 

6026 

3650 


DCA I SBOT 

602 7 

7132 


CLL CML RTR /2000 

60 30 

1251 


TAD SRI 

60 31 

3652 


DCA I SPW1 /GET PUTSW1 

60 32 

1255 


TAD SR3 

60 33 

3653 


DCA I SPBK 

6034 

1255 


TAD SR3 


BLOCK 
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60 3 5 

7001 


I AC 


6036 

3654 


DCA 

I SP LK 

60 3 7 

5551 


JMP 

I Z INTI /GET NEXT INSTRUCTION 

60 40 

0000 

FILBj 

0 

/ROUTINE TO FILL UP LAST BUFFER 

60 41 

4647 


JMS 

I P UTF 

6042 

1 652 


TAD 

I SP W1 

60 43 

1073 


TAD 

Z C200 

60 44 

7 640 


SZA 

CLA 

60 4 5 

52 41 


JMP 

• - 4 

6046 

5640 


JMP 

I FI LB 

60 4 7 

5345 

P UTF > 

PUT 

+ 4400 

60 50 

5375 

SB 01 > 

BO UT +4400 

60 51 

0000 

SRI , 

0 


60 52 

5377 

SPW1 , 

PUTSW1+4400 

6053 

53 54 

SPBKj 

P UT6LK + 4400 

60 54 

5356 

SP LK * 

P UTLNK+ 4400 

60 55 

0000 

SR 3 j 

0 





* 3000 



/ROUTINE TO 

SAVE SWITCHES FOR NEXT TIME 

3000 

0000 

SSW, 

0 


3001 

1 643 


TAD 

I SWBO /SAVE BOUT 

3002 

3244 


DCA 

SWT 1 

3003 

1244 


TAD 

SWT1 

3004 

1272 


TAD 

M2 

3005 

3274 


DCA 

SWT1 2 

300 6 

1 674 


TAD 

I SWT 12 

300 7 

1273 


TAD 

M 7 7 1 2 

30 10 

7640 


SZA 

CLA 

301 1 

521 4 


JMP 

GOW 

30 1 2 

1274 


TAD 

SWT 1 2 

30 1 3 

3244 


DCA 

SWT 1 

30 1 4 

1 645 

GO W, 

TAD 

I SWG /SAVE GETSW1 

30 1 5 

3246 


DCA 

SWT2 

301 6 

1 647 


TAD 

I SWGL /SAVE GETLNK 

301 7 

32 50 


DCA 

SWT 3 

3020 

1 651 


TAD 

I SWBI /SAVE BINP 

3021 

3252 


DCA 

SWT 4 

3022 

1 653 


TAD 

I SWP /SAVE PUTSW1 

3023 

3254 


DCA 

SWTS 

3024 

1 655 


TAD 

I SWPB /SAVE PUTBLK 

3025 

3256 


DCA 

SWT 6 

3026 

1 657 


TAD 

I SWPL /SAVE PUTLNK 

3027 

3260 


DCA 

SWT 7 

30 30 

700 1 


I AC 

/SET DUMMY =1 

3031 

3661 


DCA 

I S WDM 

30 32 

1 662 


TAD 

I SCH /SAVE SWCH 

30 33 

3263 


DCA 

SWT8 

30 34 

1 664 


TAD 

I TPD /SAVE TPWD 

3035 

3265 


DCA 

SWT9 

30 3 6 

1 666 


TAD 

I PS1 /SAVE PSW1 

30 3 7 

3267 


DCA 

SWT0 

30 40 

1 670 


TAD 

I TEPZ /SAVE TEMPZ 

3041 

3271 


DCA 

SWT1 1 

30 42 

5600 


JMP 

I SSW 

3043 

5375 

S WBO » 

BOUT+4400 
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30 44 

0000 

SWT1 , 

3045 

5343 

SWG, 

30 46 

0000 

SWT2, 

30 47 

5334 

SWGL, 

30 50 

0000 

SWT3, 

30 51 

5376 

S WBI, 

30 52 

0000 

SWT4, 

30 53 

5377 

SWP, 

3054 

0000 

SWT5, 

30 55 

5354 

SWPB, 

3056 

0000 

SWT6, 

3057 

5356 

SWPL, 

30 60 

0000 

S WT7 , 

30 61 

0476 

S WDM* 

30 62 

5236 

SCH, 

3063 

0000 

SWTS, 

30 64 

5237 

TPD, 

30 65 

0000 

SWT9 , 

3066 

5307 

PS1 , 

3067 

0000 

SWT0, 

30 70 

531 1 

TEPZ, 

3071 

0000 

SWT11, 

30 72 

7776 

M2, 

3073 

0066 

M7712, 

3074 

0000 

SWT12, 

/ROUTI 

3075 

0000 

PSW, 

30 76 

1244 


30 7 7 

3643 


3100 

1246 


3101 

3645 


3102 

12 50 


3103 

3647 


3104 

1252 


3105 

3651 


3106 

1254 


3107 

3653 


31 10 

1256 


3111 

3655 


3112 

12 60 


3113 

3657 


31 1 4 

1263 


31 1 5 

3662 


31 1 6 

1265 


31 1 7 

3664 


3120 

1267 


3121 

3666 


3122 

1271 


3123 

3670 


3124 

1 332 


3125 

3733 


3126 

1 331 


3127 

3734 


3130 

5675 


3131 

0 70 3 

P 703, 


0 

GETSW1+4400 
0 

GETLNK + 4400 
0 

BINP+4400 

0 

PUTSW1 +4400 
0 

P UTBLK + 4400 
0 

P UTLNK+ 4400 
0 

DUMMY 

SWCH+4400 

0 

TPWD+4400 
0 

PSW1 +4400 
0 

TEMPZ+4400 

0 

-2 

-7712 

0 


NE TO 

PUT SWITCHES 

0 


TAD 

SWT 1 

DCA 

I S WBO 

TAD 

SWT2 

DCA 

I SWG 

TAD 

SWT3 

DCA 

I SWGL 

TAD 

SWT4 

DCA 

I SWBI 

TAD 

SWT5 

DCA 

I SWP 

TAD 

SWT 6 

DCA 

I SWPB 

TAD 

SWT 7 

DCA 

I SWPL 

TAD 

SWTS 

DCA 

I SCH 

TAD 

SWT9 

DCA 

I TPD 

TAD 

SWT0 

DCA 

I PS1 

TAD 

SWT1 1 

DCA 

I TEPZ 

TAD 

P 70 5 

DCA 

I PWT 

TAD 

P 70 3 

DCA 

I GWT 

JMP 

I PSW 

70 3 



20 




32 

0705 

P 

705, 

70 5 

33 

5353 

P 

WT, 

753+4400 

34 

5331 

G 

WT, 

731+4400 


ADN 1724 
AX0 0010 
AX 1 0011 

BEGIN 0200 
BINP 0776 
BINW 60 1 7 
BL 1712 

BLOT 60 20 
BOUT 0775 
BUFADR 0043 
BUFOBJ 0044 
CCHAIN 0443 
C2 0300 

C200 0073 

C2 600 171 5 

(J2 601 1713 

C2 602 1 71 6 

C5000 0475 

C 6000 1714 

C6065 0473 

C 70 3 0275 

C70 5 0273 

DNSRN 0023 
DN200 1072 

DUMMY 0476 
DUMW 0277 
FBLKK 0471 
FCORE 0454 
FFBLK 1707 
F GO 0450 
FH2A 0301 
FH3 0256 
FI LB 6040 
FILN1 0466 
FILN2 0467 
FLINK 0455 
FMOVE 1657 
FNAM1 1710 
FNAM2 1711 
FX0 2004 
FX1 2015 
GETLNK 0734 
GETSW1 0743 
GO W 3014 
GTW 0276 
GTWD 0041 
GWT 3134 
ILC 0014 
INTI 0 151 
IOERR 4000 
IR200 1733 




KFH1 

1 664 

KFH2A 

1717 

KMOVE 

2000 

LKLK 

1 600 

LKO 

1 61 6 

LLKK 

0155 

LNDX 

0021 

LNKWD 

0042 

LTST 

0020 

MONITR 

1 720 

MONRET 

0076 

MPNT 

00 1 5 

M2 

30 72 

M4600 

0474 

M7712 

30 73 

NAM1 

1 640 

NAM2 

1 641 

NON 

1 725 

NULL 

0113 

OBJBLK 

0027 

POTR 

1 722 

POTR1 

1 721 

PRINT 

1 755 

PSW 

30 7 5 

PSW1 

0 70 7 

PS1 

3066 

PTW 

0274 

PIJSW 

1 731 

PUT 

0745 

PUTBLK 

0754 

PUT EOF 

0101 

PUTF 

6047 

PUTLNK 

0756 

PUTSW1 

0777 

PWT 

3133 

P200 

0470 

P 5 

1 732 

P 51 0 7 

1 735 

P 5535 

1 734 

P 70 3 

3131 

P 70 5 

3132 

P 77 

1 775 

QMARK 

1 773 

RBLK 

6002 

RCOR 

6003 

REW 

6000 

REX 1 

2031 

REX2 

2032 

REZ 

2033 

RGTSW 

601 5 

RLNK 

6004 

SASW 

1 730 

SAVB 

0472 

SAX 1 

2026 

SAX2 

2027 




SAZ 

20 30 

SBOT 

60 50 

SBSRN 

00 24 

SCH 

30 62 

SCL 

1 726 

SMC 

1 727 

SPACE 

1 774 

SPBK 

60 53 

SPLK 

60 54 

SP W1 

60 52 

SRI 

6051 

SR 3 

6055 

SSTR 

0 1 54 

SSTT 

2025 

SSW 

3000 

SWBI 

30 51 

SWBO 

3043 

SWCH 

0636 

S WDM 

30 61 

SWG 

3045 

SWGL 

3047 

SWP 

30 53 

S WP B 

3055 

SWP L 

30 5 7 

SWT0 

30 6 7 

SWT1 

3044 

SWT 1 1 

30 71 

SWT 12 

30 7 4 

SWT 2 

3046 

SWT 3 

30 50 

SWT 4 

30 52 

SWT 5 

3054 

SWT 6 

3056 

SWT 7 

30 60 

SWT8 

3063 

SWT 9 

3065 

SYSIO 

0077 

TDN 

1 723 

TEMB 

0016 

TEMC 

00 1 7 

TEMPZ 

0711 

TEPZ 

30 70 

TLNK 

601 6 

TMES 

0560 

TMSI 

1 777 

tpd 

3064 

TP WD 

0637 

TTYOUT 

0514 

TYPE 

1 776 

WRITE 

1 736 

• LOAD 

* IN- D7 

: FOSLj S:F05 


* 
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ST = 

t t r 

1 SAVE FOSU0-2177,3000,6000*200 
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/OPERA!I 
/"CALL” 
/"BLOCK 
/ 

/SYSTEM 


NG SYSTEM MODIFICATIONS TO SERVICE 
i "RETURN’^ "CHAIN”; "REWIND" AND 
OUT" STATMENTS• 

DEFINITIONS: 

NSUB=2670 
LSUB=2677 
CCHAIN= 50 43 
REW= 6000 
BLOT=6020 
*3057 


3057 

6000 


REW /GO TO REWIND INSTR. 

30 60 

6020 


BLOT /GO TOBLOCK OUT INSTR. 

30 61 

3775 


CALLIN /GO TO CALL INST. 

30 62 

21 74 


RETIN /GO TO RETURN INSTR. 

30 63 

5043 


CCHAIN /GO TO CHAIN INSTR. 

*3775 

3775 

1056 

CALLIN, 

TAD PTW /TAKE POINTER 

3776 

5777 


JMP I .+1 /STACK RETURN WITH NSUB 

3777 

2670 


NSUB 

PTW=56 
*2 1 74 

21 74 

5775 

RETIN, 

JMP I .+1 /RETURN WITH THE HELP OF 

2 1 75 

2677 


LSUB 

*312 

0312 

7540 


SMA SZA /IS IT ON TABLE? 

*2765 

2765 

0200 


200 




*36 

0036 

60 5 5 


60 55 
*5067 

50 67 

471 1 

ADSMFX, 

5111-200 /RETURN TO THE MONITOR 

ADSMFX 

5067 



BLOT 

60 20 



CALLIN 

3775 



CCHAIN 

5043 



LSUB 

2677 



NSUB 

2670 



P T W 

0056 



RETIN 

2174 



REW 

6000 



.LOAD 
* I N - D 7 

:.OS., 

S: FO 3 



LSLIB 


ST = 

r r t 

iSAVE .OS. ! 0 - 51 77;0 
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